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-- Expression. mesa, modified by Sweet, Aug 29, 1978 2:05 PM 

DIRECTORY 

AltoDefs: FROM "altodefs" USING [BYTE, BytesPerWord, wordlength], 

Code: FROM "code" USING [acstack, catchcount, CodeNotlmplemented, curctxlvl, f irstcasesel read, xtract 
**ing, xtractlex], 

CodeDefs: FROM "codedefs" USING [BDOComponent , BDOIndex, ChunkBase, FullBitAddress , Lexeme, 1TOS, Reg 
**isterName, topostack, TosBDOComponent, WordZeroBDOComponent], 

ComData: FROM "comdata", 

ControlDefs: FROM "controldef s" USING [ControlLink, EPRange, GFTNull , Greg, Lreg, ProcDesc, SignalDes 
**c], 

FOpCodes: FROM "fopcodes" USING [qADD, qAND, qBLTC, qBLTCL, qDADD, qDESCB, qDESCBS, qDIV, qDSUB, qEXC 
**H, qGAORB, qLADRB, qLI , qLLK, qMUL, qNEG, qPOP, qPUSH, qRR, qRSTR, qRSTRL, qSDIV, qSHIFT, qSUB], 

InlineDefs: FROM "inlinedefs" USING [BITAND, BITSHIFT, DIVMOD], 

LitDefs: FROM "litdefs" USING [LTIndex, lttype, MasterString, MSTIndex, sttype], 

P5ADefs: FROM "p5adefs" USING [addfulladdrtobits , CioutO, Cioutl, Cload, copyBDOItem, Csyscall , Csysc 

**alln, genBDOItem, gentemplex, incrstack, loadaddress, loadlexaddress , loadtsonaddress , makeBDOItem, m 

**akeretlex, maketempaddrBDOItem, makeTOSaddrBDOItem, makeTOSlex, maketsonBDOItem, markstack, operandty 

**pe, P5Error, releaseBDOItem, RequireStack, rmakeBDOItem, treeliteral, tree! iteral value, wordsforsei], 
** 

P5BDefs: FROM "p5bdefs" USING [Ccasestmtexp, Cflowexp, movetocodeword, writecodeword] , 
P5StmtExprDefs: FROM "p5stmtexprdef s" USING [Cassignx, Cbodyinit, Ccallexp, Cconstructx, Cdindex, Cfo 
**rkexp, Cindex, Cjoinexp, Cnew, Cportinit, Crowconsx, Csigerrexp, Cstartexp, Cstringinit, Cvconstructx 

SDDefs: FROM "sddefs" USING [sFADD, sFDIV, sFLOAT, sFMUL, sFSUB, sLongDiv, sLongMod, sLongMul], 
StringDefs: FROM "stringdefs" USING [StringHeaderSize] , 

SymDefs: FROM "symdefs" USING [BitAddress, bodytype, BTIndex, BTNull , CBTIndex, ContextLevel, CSEInde 
**x, CTXIndex, ctxtype, HTIndex, ISEIndex, 1Z, SEIndex, setype], 

SymTabDefs: FROM "symtabdefs" USING [FnField, NormalType, UnderType, WordsForType, XferMode], 

TableDefs: FROM "tabledefs" USING [TableBase, TableNotif ier], 

TreeDefs: FROM "treedefs" USING [empty, testtree, Treelndex, TreeLink, treetype]; 

DEFINITIONS FROM FOpCodes, CodeDefs; 

Expression: PROGRAM 

IMPORTS CPtr: Code, LitDefs, PSADefs, P5BDefs, P5StmtExprDef s , SymTabDefs, TreeDefs 

EXPORTS CodeDefs, P5BDefs 

SHARES LitDefs, StringDefs - 
BEGIN 
OPEN P5ADefs, P5StmtExprDef s , P5BDefs; 

-- imported definitions 

BYTE: TYPE ■ AltoDefs. BYTE ; 

wordlength: CARDINAL » Al toDefs. wordlength; 

BytesPerWord: CARDINAL = Al toDefs .BytesPerWord; 

StringHeaderSize: CARDINAL = StringDefs .StringHeaderSize; 

MSTIndex: TYPE = LitDefs .MSTIndex; 

BitAddress: TYPE ■ SymDefs .BitAddress; 
BTIndex: TYPE = SymDefs .BTIndex; 
CBTIndex: TYPE - SymDefs .CBTIndex; 
BTNull: BTIndex - SymDefs .BTNull ; 
ContextLevel: TYPE ■ SymDefs .ContextLevel ; 
CSEIndex: TYPE ■ SymDef s.CSEIndex; 
CTXIndex: TYPE - SymDef s .CTXIndex; 
HTIndex: TYPE « SymDef s .HTIndex; 
ISEIndex: TYPE ■ SymDef s . ISEIndex; 
1Z: ContextLevel * SymDefs. 1Z; 
SEIndex: TYPE = SymDef s .SEIndex; 
LTIndex: TYPE ■ Li tDefs . LTIndex; 

empty: TreeLink * TreeDefs .empty; 
Treelndex: TYPE ■ TreeDefs .Treelndex; 
TreeLink: TYPE « TreeDefs. TreeLink; 

tb: TableDefs. TableBase; -- tree base (local copy) 

seb: TableDefs. TableBase; -- semantic entry base (local copy) 

ctxb: TableDefs. TableBase; -- context entry base (local copy) 

bb: TableDefs. TableBase; -- body entry base (local copy) 

cb: ChunkBase; -- code base (local copy) 

stb: TableDefs. TableBase; -- string base (local copy) 

Itb: TableDefs. TableBase; -- literal base (local copy) 
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ExpressionNotify: PUBLIC TableDef s .TableNotif ier ■ 

BEGIN -- called by allocator whenever table area is repacked 

stb <- base[LitDefs.sttype]; 

seb <- base[SymDef s .setype]; 

ctxb «- base[SymDef s.ctxtype]; 

bb <- base[SymDefs.bodytype] ; 

tb <- base[TreeDef s . treetype] ; 

cb <- L00PH0LE[tb]; 

ltb <- base[LitDefs.lttype]; 

RETURN 

END; 

Cexp: PUBLIC PROCEDURE [t: TreeLink] RETURNS [1: Lexeme] - 
BEGIN -- generates code for an expression 
sei: ISEIndex; 
node: Treelndex; 
a: BitAddress; 
bti: CBTIndex; 
psize: CARDINAL; 

WITH e: t SELECT FROM 
literal ■> 

WITH e.info SELECT FROM 

word => RETURN[Lexeme[l iteral[word[index]]]]; 

string => RETURN[Lexeme[l iteral[string[index]]]]; 

ENDCASE; 
symbol «> 
BEGIN 

sei +• e. index; 
IF (seb+sei) .linkSpace THEN 

BEGIN 

a <- (seb+sei) . idvalue; 

Cioutl[FOpCodes.qLLK, a.wd]; 

RETURN[topostack]; 

END; 
IF (seb+sei) .constant AND SymTabDef s .XferMode[(seb+sei ) . idtype] ■ procedure THEN 

BEGIN 

IF (seb+sei) .extended THEN SIGNAL CPtr .CodeNotlmplemented; 

bti «- (seb+sei) . idinfo; 

IF bti = BTNull THEN pushl i tval[(seb+sei) . idvalue] 

ELSE pushlprocdesc[bti]; 

RETURN[topostack]; 

END; 
RETURN[Lexeme[se[sei]]]; 
END; 
subtree «> 
BEGIN 

IF e « empty AND CPtr .xtracting THEN RETURN[CPtr .xtractlex]; 
node <- e. index; 
SELECT (tb+node).name FROM 

caseexp => 
BEGIN 

psize «- Ccasestmtexp[node, TRUE]; 

1 <- makeretlex[SymTabDefs.WordsForType[(tb+node). info], psize]; 
END; 

assignx »> 1 «- Cassignx[node]; 

plus *> 1 <- Cplus[node]; 

minus «> 1 <- Cminus[node]; 

div => 1 <- Cdiv[node]; 

mod B > 1 <- Cmod[node]; 

times »> 1 <- Ctimes[node]; 

dot, uparrow => 1 <- Cdotoruparrow[node]; 

reloc «> 1 <- Creloc[node, FALSE]; 

dollar «> 1 <- Cdollar[node] ; 

uminus B > 1 <- Cuminus[node] ; 

addr «> 1 <- Caddr[node]; 

index ■> 1 <- Cindex[node]; 

dindex ■ > 1 <- Cdindex[node] ; 

constructx => 1 «- Cconstructx[node]; 

vconstructx »> 1 «- Cvconstructx[node]; 

arraydesc ■> 1 <- Carraydesc[node]; 

length »> 1 <- Clength[node] ; 

base ■> 1 <- Cbase[node]; 

portinit ■> 1 *- Cportinit[node]; 

body ■> 1 +• Cbodyinit[node]; 
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rowconsx ■> 1 «- Crowconsx[node]; 

stringinit ■> 1 «- Cstringinit[node]; 

align «> P5ADefs.P5Error[641]; 

cast ■> 1 <- Cexp[(tb+node) .sonl]; 

seqindex ■> 1 «- Cseqindex[( tb+node) . sonl , (tb+node) ,son2] ; 

register ■> 1 «- Cregister[node]; 

memory ■> 

BEGIN 

pushrhs[( tb+node) .sonl]; 
z 1 <- Lexeme[bdo[makeTOSaddrBDOItem[wordlength]]]; 

END; 
item -> 1 <- Cexp[(tb+node) .son2]; 

temp »> 1 <- gentemplex[SymTabDefs.WordsForType[(tb+node) .info]]; 
call, portcall »> 1 <- Ccallexp[node] ; 
signal .error -> 1 <- Csigerrexp[node] ; 
start ■> 1 <- Cstartexp[node]; 
new ■> 1 <- Cnew[node]; 
mwconst ■> 1 <- Cmwconst[node] ; 
signalinit «> 1 «- Csignal init[node]; 
fork b > 1 *- Cforkexp[node]; 
join «> 1 ♦- Cjoinexp[node]; 
float *> 1 <- Cfloat[node]; 
ENDCASE »> 1 ♦- Cflowexp[node]; 
END; 
ENDCASE; 
RETURN 
END; 

constoperand: PROCEDURE [t: TreeLink] RETURNS [BOOLEAN, INTEGER] » 
BEGIN -- if t is a literal node, return [TRUE , val( t)j 
IF treeliteral[t] THEN 

RETURN [TRUE, treel i teral val ue[t]] 
ELSE RETURN [FALSE, 0] 
END; 

Dsyscall: PROCEDURE [op: BYTE] * 
BEGIN 

Csyscalln[op,2]; 
END; 

Cplus: PROCEDURE [node: Treelndex] RETURNS [Lexeme] » 
BEGIN -- generate code for + 
double: BOOLEAN - (tb+node) .attrl ; 
real: BOOLEAN; 
IF double THEN 

BEGIN 

RequireStack[0]; 

IF (real «- (tb+node) . attr2) THEN markstack[]; 

END; 
pushrhs[( tb+node) . sonl]; 
pus hrhs[( tb+node) .son2]; 
IF double THEN 

BEGIN 

IF real THEN Dsyscal l[SDDef s .sFADD] 

ELSE CioutO[qDADD]; 

RETURN[makeTOSlex[2]] 

END; 
CioutO[qADD]; 
RETURN[topostack] 
END; 



Cminus: PROCEDURE [node: Treelndex] RETURNS [Lexeme] 
BEGIN -- generate code for - 
double: BOOLEAN - (tb+node) .attrl ; 
real: BOOLEAN; 
IF double THEN 

BEGIN 

RequireStack[Q]; 

IF (real <- (tb+node) .attr2) THEN markstack[]; 

END; 
pushrhs[( tb+node) . sonl]; 
pushrhs[( tb+node) .son2]; 
IF double THEN 

BEGIN 
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IF real THEN Dsyscall[SDDef s.sFSUB] 

ELSE C1outO[qDSUB]; 

RETURN[makeT0Slex[2]] 

END; 
CioutO[qSUB]; 
RETURN[topostack] 
END; 

Cuminus: PROCEDURE [node: Treelndex] RETURNS [1: Lexeme] ■ 
BEGIN -- generate code for unary minus 
tt: TreeLink <- (tb+node) .sonl; 
double: BOOLEAN « (tb+node) . attrl; 
real: BOOLEAN; 

1 4- IF double THEN makeT0Slex[2] ELSE topostack; 
WITH tt SELECT FROM 

subtree ■> 

IF (tb+index) .name ■ uminus THEN 

BEGIN pushrhs[(tb+index).sonl]; RETURN END; 

ENDCASE; 
IF double THEN 

BEGIN 

RequireStack[0]; 

IF (real «- (tb+node) .attr2) THEN BEGIN markstack[]; markstack[]; END; 

pushlitval[0]; pushl itval[0]; 

IF real THEN Dsyscal l[SDDef s .sFLOAT] ; 

END; 
pushrhs[tt]; 
IF double THEN 

IF real THEN Dsyscal 1 [SDDefs . sFSUB] 

ELSE CioutO[qDSUB] 
ELSE CioutO[qNEG]; 
RETURN 
END; 

Ctimes: PROCEDURE [node: Treelndex] RETURNS [Lexeme] « 
BEGIN -- generates code for multiply 
double: BOOLEAN - (tb+node) . attrl ; 

IF double THEN BEGIN RequireStack[0] ; markstack[] END; 
pushrhs[( tb+node) .sonl]; 
pushrhs[( tb+node) . son2]; 
IF double THEN 

BEGIN 

Dsyscall[IF (tb+node) . attr2 THEN SDDefs. sFMUL 
ELSE SDDefs. sLongMul]; 

RETURN[makeTOSlex[2]]; 

END; 
CioutO[qMUL]; 
RETURN[topostack] 
END; 

log2: PROCEDURE [i: INTEGER] RETURNS [BOOLEAN, [0..16]] ■ 
BEGIN OPEN InlineDefs; 
shift: [0..16]; 

IF i - THEN RETURN [FALSE, 0]; 

i ♦- ABS[i]; 

IF BITAND[i, 1-1] # THEN RETURN [FALSE, 0]; 

FOR shift IN [0. .16) DO 

IF BITAND[i,l] - 1 THEN RETURN[TRUE, shift]; 

i <- BITSHIFT[i, -1]; 

ENDLOOP 
END; 

Cdiv: PROCEDURE [node: Treelndex] RETURNS [1: Lexeme] - 
BEGIN -- generate code for divide 
double: BOOLEAN » (tb+node) . attrl ; 
rand21it, powerof2: BOOLEAN; 
rand2val: INTEGER; 
shift: [0..16]; 

1 *- IF double THEN makeTOSlex[2] ELSE topostack; 
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IF double THEN BEGIN RequireStack[0] ; markstack[] END; 
pus hrhs[( tb+node) .sonl]; 
IF -double AND (tb+node) .attr2 THEN 
BEGIN 

[rand21it, rand2val] <- constoperand[(tb+node) .son2]; 
IF rand21it AND rand2val > THEN 
BEGIN 

[powerof2, shift] ♦• log2[rand2val ]; 
IF powerof2 THEN 

BEGIN pushlitval[-shift]; CioutO[qSHIFT]; RETURN END; 
END; 
END; 
pushrhs[( tb+node) . son2]; 
IF double THEN 
BEGIN 
Dsyscall[IF (tb+node) .attr2 THEN SDDefs.sFDIV 

ELSE SDDefs.sLongDiv]; 
RETURN[makeTOSlex[2]]; 
END; 
IF (tb+node). attr2 THEN CioutO[qDIV] 
ELSE CioutO[qSDIV]; 
RETURN 
END; 



Cmod: PROCEDURE [node: Treelndex] RETURNS [1: Lexeme] ■ 
BEGIN -- generate code for MOD 
double: BOOLEAN ■ (tb+node) . attrl; 
rand21it, powerof2: BOOLEAN; 
rand2val: INTEGER; 

1 ♦■ IF double THEN makeTOSlex[2] ELSE topostack; 
IF double THEN 

BEGIN 

IF (tb+node). attr2 THEN SIGNAL CPtr .CodeNotlmplemented; 

RequireStack[0]; markstack[] 

END; 
pushrhs[( tb+node) .sonl]; 
IF -double AND (tb+node) . attr2 THEN 

BEGIN 

[rand21it, rand2val] «- constoperand[(tb+node) .son2]; 

IF rand21it AND rand2val > THEN 
BEGIN 

[powerof2, ] <- log2[rand2val] ; 
IF powerof2 THEN 

BEGIN pushlitval[rand2val-l]; CioutO[qAND]; RETURN END; 
END; 

END; 
pushrhs[( tb+node) . son2]; 
IF double THEN 

BEGIN 

Csyscall[SDDefs.sLongMod]; 

CPtr.acstack «- 2; 

incrstack[2]; 

RETURN 

END; 
IF (tb+node). attr2 THEN CioutO[qDIV] 
ELSE CioutO[qSDIV]; 
CioutO[qPUSH]; 
CioutO[qEXCH]; 
CioutO[qPOP]; 
RETURN 
END; 

Cfloat: PROCEDURE [node: Treelndex] RETURNS [Lexeme] - 
BEGIN 

RequireStack[0]; 
markstack[]; 

pushrhs[( tb+node) .sonl]; 
Dsyscall[SDDefs,sFLOAT]; 
RETURN[makeT0Slex[2]]; 
END; 

Caddr: PROCEDURE [node: Treelndex] RETURNS [Lexeme] - 
BEGIN -- generates code for "@ M 
psize: CARDINAL ■ loadtsonaddress[( tb+node) . sonl]; 
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RETURN[IF psize > wordlength THEN makeT0S1ex[2] ELSE topostack] 
END; 

Cregister: PROCEDURE [node: Treelndex] RETURNS [Lexeme] ■ 
BEGIN -- creates lexeme for (some) r-register 

RETURN [Lexeme[other[register[ tree! iteralvalue[(tb+node). sonl]]]]]; 
END; 

Cregload: PUBLIC PROCEDURE [v: RegisterName] ■ 

BEGIN — pushes value of (some) r-register on stack 
OPEN ControlDefs; 
SELECT v FROM 

Lreg => Cioutl[qLADRB, 0]; 

Greg «> Cioutl[qGADRB, 0]; 

ENDCASE *> IF v < 100B THEN BEGIN Cioutl[qRR, v] END 
ELSE SIGNAL CPtr .CodeNotlmplemented ; 
RETURN 
END; 

Cseqindex: PROCEDURE [string, index: TreeLink] RETURNS [Lexeme] - 
BEGIN 

psize: CARDINAL; 
psize <- spushrhs[string]; 
pushrhs[index]; 

RETURN [ Lexeme [other[byte[StringHeaderSize*BytesPerWord , psize>word length]]]] 
END; 

Carraydesc: PROCEDURE [node: Treelndex] RETURNS [Lexeme] ■ 

BEGIN -- pushes two components of an array descriptor onto stack 
size: CARDINAL; 

WITH (tb+node).sonl SELECT FROM 
subtree «> 
BEGIN 

size «- spushrhs[(tb+index) . sonl]; 
size «- spushrhs[(tb+index) . son2] + size; 
END; 
ENDCASE; 
RETURN[makeTOSlex[ size/word length]] 
END; 

Clength: PROCEDURE [node: Treelndex] RETURNS [1: bdo Lexeme] « 
BEGIN -- generates code to extract length from array descriptor 
r: BDOIndex; 
IF TreeDefs.testtree[(tb+node).sonl, reloc] THEN 

SIGNAL CPtr. CodeNotlmplemented; 
r «- (1 <r maketsonBDOItem[(tb+node) .sonl]) .lexbdoi; 
cb[r].off set.posn.wd «- 

cb[r].off set. posn,wd+(cb[r]. off set. size-word! ength) /wordlength; 
cb[r], off set. size «- wordlength; 
RETURN 
END; 

Cbase: PROCEDURE [node: Treelndex] RETURNS [Lexeme] « 

BEGIN -- generates code to extract base from array descriptor 

1 : bdo Lexeme; 

psize: CARDINAL; 

tl: TreeLink «- (tb+node) .sonl; 

IF TreeDefs.testtree[tl, reloc] THEN 

BEGIN 

psize *- loadlexaddress[Creloc[LOOPHOLE[tl, subtree TreeLink]. index, TRUE]]; 

RETURN[IF psize - wordlength THEN topostack ELSE makeT0Slex[2]] ; 

END 
ELSE 

BEGIN 

1 <- maketsonBDOItem[tl]; 

cb[l .lexbdoi]. offset. size «- cb[l . lexbdoi]. off set .size - wordlength; 

END; 
RETURN[1] 
END; 
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Cdotoruparrow: PROCEDURE [mainnode: Treelndex] RETURNS [Lexeme] ■ 
BEGIN 

-- generate code for "exp. field" 
tl: TreeLink «- (tb+mainnode) .sonl; 
sei: ISEIndex; 
node: Treelndex; 
csei: CSEIndex; 
rr, r: BDOIndex; 
1, lr: Lexeme; 

duasym: PROCEDURE [tsei: ISEIndex] RETURNS [1: Lexeme] ■ 
BEGIN 

a: BitAddress; 

IF (seb+tsei). linkSpace THEN 
BEGIN 

pushlex[[se[tsei]]]; 

RETURN[[bdo[r <- makeTOSaddrBDOItem[wordlength]]]]; 
END; 
1 <- Lexeme[bdo[r ♦■ genBDOItem[]]]; 
cb[r].tag <- bo; 
a «- (seb+tsei) .idvalue; 
cb[r].base <- 

BDOComponent[posn: Ful lBitAddress[bd: a.bd, wd: a.wd], 
size: (seb+tsei) . idinfo, 
level : (ctxb+( seb+tsei) .ctxnum) .ctx level]; 
RETURN 
END; 

IF (tb+mainnode) .name ■ uparrow THEN sei <- (tb+mainnode) . info 
ELSE 

WITH (tb+mainnode). son2 SELECT FROM 
symbol K > sei <- index; 
ENDCASE; 
WITH tl SELECT FROM — produces better code if LOOPHOLE is present 
subtree H > IF (tb+index) .name ■ cast THEN tl «- (tb+index) .sonl; 
ENDCASE; 
WITH tl SELECT FROM 

symbol => 1 «- duasym[index]; 
subtree ■> 
BEGIN 

node «- index; 

SELECT (tb+node) .name FROM 
plus ■> 
BEGIN 

r *- genBDOItem[]; 
cb[r].tag <- bdo; 
1 <- Cexp[(tb+node) .sonl]; 
WITH 1 SELECT FROM 

se ■> 1 *- makeBDOItem[l]; 
bdo -> NULL; 

ENDCASE ■> BEGIN 1 <- lpushlex[l]; END; 
WITH 1 SELECT FROM 

bdo ■> IF cb[lexbdoi].tag n o THEN 1 «- lpushlex[l]; 
ENDCASE; 
WITH 1 SELECT FROM 

se *> cb[r].base *• [level: 1T0S» posn: FullBitAddress[0, 0], size: wordlength]; -- topost 
**ack if here 

bdo ■> 
BEGIN 

rr «- lexbdoi; 

cb[r].base <- cb[rr]. offset; 
releaseBDOItem[rr] ; 
END; 
ENDCASE; 
lr 4- Cexp[(tb+node) .son2]; 
WITH lr SELECT FROM 

se a > lr <- makeBDOItem[lr]; 
bdo -> NULL; 

ENDCASE ■> lr ♦- lpushlex[lr]; 
WITH lr SELECT FROM 

bdo »> IF cb[lexbdoi].tag ft o THEN lr ♦- lpushlex[lr]; 
ENDCASE; 
WITH lr SELECT FROM 

se ■> cb[r].disp ♦• [level: 1TOS, posn: FullBitAddress[0, 0], size: wordlength]; -- topost 
**ack if here 

bdo -> 
BEGIN 
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rr «- lexbdoi; 

cb[r].disp «- cb[rr]. offset; 
releaseBDOItem[rr]; 
END; 
ENDCASE; 
1 «- [bdo[r]]; 
END; 
ENDCASE -> 
BEGIN 

1 «- [bdo[r «- maketempaddrBDOItem[lpushrhs[tl]]]]; 
END; 
END; 
literal ■> 
BEGIN 

pushconst[tl]; 

1 <- Lexeme[bdo[r ♦• makeTOSaddrBDOItem[wordlength]]]; 
END; 
ENDCASE; 
cb[r]. offset. level «- 1Z; 
IF (tb+mainnode) .name a uparrow THEN 
BEGIN 

cb[r] .of f set. size «- wordlength*wordsforsei[sei]; 
cb[r]. offset. posn <- FullBitAddress[0, 0]; 
END ELSE 
IF (seb+sei) .constant THEN 
BEGIN 

ConstantField[r , sei]; 
RETURN[topostack] 
END 
ELSE 
BEGIN 

WITH (seb+SymTabDefs.NormalType[operandtype[(tb+mainnode) .sonl]]) SELECT FROM 
pointer => 

BEGIN OPEN SymTabDefs; 
cb[r], offset. posn <- FullBitAddress[0 ,0]; 
csei «- UnderType[pointedtotype]; 

cb[r] .off set. size «- adjustbdoitem[r , csei, sei, WordsForType[csei]*wordlength] ; 
addBitAddresstooff set[r, (seb+sei) . id value]; 
END; 
ENDCASE => P5ADefs.P5Error[642]; 
END; 
RETURN[1] 
END; 

Creloc: PUBLIC PROCEDURE [node: Treelndex, al lowdescriptor: BOOLEAN] 
RETURNS [Lexeme] - 

BEGIN -- generates code for "baseptr[relptr]" 
psize: CARDINAL; 
rb, rd, rr: BDOIndex; 
rr «- genBDOItem[]; 

cb[rr].of fset <- WordZeroBDOComponent; 

cb[rr]. offset. size <- wordlength*SymTabDef s .WordsForType[(tb+node) . info]; 
cb[rr].tag <- bdo; 

rb <- rmakeBDOItem[Cexp[(tb+node) .sonl]]; 
psize *- cb[rb]. offset. size; 
IF cb[rb].tag ■ o THEN 

BEGIN 

cb[rr].base <- cb[rb] .offset; 

releaseBDOItem[rb] ; 

END 
ELSE 

BEGIN 

Cload[rb]; 

cb[rr].base «- TosBDOComponent; 

cb[rr]. base. size <- MAX[wordlength, psize]; 

END; 

rd «- rmakeBDOItem[Cexp[(tb+node) .son2]]; 
IF (tb+node).attr2 THEN 

BEGIN 

IF cb[rd].tag « o AND cb[rd]. offset. level - UOS THEN Ciout0[qP0P]; 

cb[rd].of fset. size «- cb[rd] .off set.size-wordlength; 

END; 
psize <- cb[rd]. offset, size; 
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IF cb[rd].tag ■ o THEN 

BEGIN 

cb[rr].disp «- cb[rd]. offset; 

releaseBDOItem[rd]; 

END 
ELSE 

BEGIN 

Cload[rd]; 

cb[rr].disp «- TosBDOComponent; 

cb[rr].disp.size <- MAX[wordlength, psize]; 

END; 

RETURN[[bdo[rr]]]; 
END; 



ConstantField: PROCEDURE [r: BDOIndex, sei: ISEIndex] ■ 
BEGIN 

p: ControlDefs.ProcDesc; 
bti: CBTIndex; 

cb[r] .offset, size <- wordlength; 
cb[r].off set.posn «- [0,0]; 

SELECT SymTabDefs.XferMode[(seb+sei).idtype] FROM 
procedure »> 
BEGIN 

IF (seb+sei). extended THEN SIGNAL CPtr .CodeNotlmplemented; 
bti «- (seb+sei) . idinfo; 
IF bti - BTNull THEN 

BEGIN pushlitval[(seb+sei).idvalue]; RETURN END; 
WITH (bb+bti) SELECT FROM 
Inner *> 
BEGIN 

cb[r].off set .posn .wd «- frameOffset; 
IF loadaddress[r] # wordlength THEN 

SIGNAL CPtr. CodeNotlmplemented; 
END; 
Outer «> 

BEGIN OPEN ControlDefs; 

IF loadaddress[r] § wordlength THEN 

SIGNAL CPtr. CodeNotlmplemented; 
p.gfi <- entrylndex/EPRange; 
p.ep <~ entrylndex MOD EPRange; 
p. tag <- procedure; 
Cioutl[qDESCBS, LOOPHOLE[p]] ; 
END; 
ENDCASE; 
END; 
signal , error ■> 
BEGIN 
IF loadaddress[r] # wordlength THEN 

SIGNAL CPtr. CodeNotlmplemented; 
Cioutl[qDESCBS, (seb+sei ). idvalue]; 
END; 
ENDCASE «> P5ADefs.P5Error[643]; 
END; 

Cdollar: PROCEDURE [node: Treelndex] RETURNS [Lexeme] - 
BEGIN -- generates code for "exp$field" 
sei: ISEIndex; 
res: CARDINAL; 
1 : bdo Lexeme; 

recsei: CSEIndex «- operandtype[(tb+node) .sonl]; 
functionCall: BOOLEAN; 
rep: BitAddress; 

WITH (seb+recsei) SELECT FROM 

record »> functionCall «- argument; 
ENDCASE => P5ADefs.P5Error[644]; 

1 *- makeBDOItem[Cexp[(tb+node) .sonl]]; 
WITH (tb+node).son2 SELECT FROM 
symbol ■> 
BEGIN 

sei +- index; 

IF (seb+sei) .constant THEN 
BEGIN 
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WITH (tb+node).sonl SELECT FROM 

subtree ■> IF (tb+index) . name # uparrow THEN P5ADefs.P5Error[645]; 
ENDCASE -> P5ADefs.P5Error[646]; 
ConstantField[l .lexbdoi, sei]; 
RETURN [topostack]; 
END; 
IF functionCall THEN 

[rep, res] <- SymTabDef s .FnFie1d[sei] 
ELSE 
BEGIN 

res «- adjustbdoitem[l .lexbdoi , recsei, sei, cb[l . lexbdoi]. off set. size]; 
rep <- (seb+sei) .idvalue; 
END; 
sdollar[l, rep, res]; 
RETURN [1]; 
END; 
ENDCASE 
END; 

adjustbdoitem: PROCEDURE [r: BDOIndex, rsei: CSEIndex, fieldsei: ISEIndex, destsize: CARDINAL] 
RETURNS [fieldsize: CARDINAL] ■ 
BEGIN 
pad: CARDINAL; 

fieldsize <- (seb+f ieldsei) . idinfo; 
WITH (seb+rsei) SELECT FROM 
record a > 
BEGIN 

IF length < wordlength AND length < destsize THEN 
BEGIN 

pad <- destsize - length; 
IF (seb+f ieldsei). idvalue ■ THEN 

fieldsize «- fieldsize + pad 
ELSE cb[r]. offset. posn «- addfull addrtobits[cb[r].off set.posn, pad]; 
END; 
RETURN 
END; 
ENDCASE => ERROR 
END; 

sdollar: PROCEDURE [1: bdo Lexeme, rep: BitAddress, res: CARDINAL] ■ 
BEGIN -- main subroutine for Cdollar and Cfdollar 
OPEN AltoDefs; 
r: BDOIndex «- 1. lexbdoi; 
ss: CARDINAL; 

IF cb[r].tag - o AND cb[r]. of f set. level = 1TOS 

AND (ss <- cb[r]. offset. size) > wordlength THEN 
BEGIN 

THROUGH [rep.wd + (res+wordlength-l)/wordlength .. ss/wordlength) DO 
CioutO[qPOP]; 

cb[r].off set. size «- cb[r] .of f set. size - wordlength; 
ENDLOOP; 
IF res O wordlength THEN 
UNTIL rep.wd = DO 

CioutO[qEXCH]; CioutO[qPOP] ; 

cb[r] .off set. size «- cb[r]. off set. size - wordlength; 
rep.wd <- rep.wd -1; 
ENDLOOP; 
END; 
addBitAddresstooff set[r, rep]; 
cb[r]. off set. size <- res; 
RETURN 
END; 

addBitAddresstooffset: PROCEDURE[r: BDOIndex, rep: BitAddress] ■ 
BEGIN 
w: CARDINAL; 

[w, cb[r], offset. posn. bd] *- In! ineDefs .DIVMOD[cb[r].of fset.posn.bd + rep.bd, wordlength]; 

cb[r] .off set .posn. wd «- cb[r] .off set .posn. wd + (rep.wd + w); 

RETURN 

END; 
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CopyLex: PROCEDURE [1 : Lexeme] RETURNS [Lexeme] ■ 
BEGIN 
WITH 1 SELECT FROM 

bdo -> RETURN [[bdo[copyBDOItem[lexbdoi]]]] ; 
ENDCASE -> RETURNp]; 
END; 

MWConstant: PUBLIC SIGNAL [cOffseg: CARDINAL] RETURNS [Lexeme] - CODE; 

Cmwconst: PROCEDURE [node: Treelndex] RETURNS [1: Lexeme] - 

BEGIN -- puts multi-word constant out to code stream and puts address on TOS 
cOffset, destpsize: CARDINAL; 
"Iti: LTIndex; 
nwords: CARDINAL; 
i: CARDINAL; 

WITH (tb+node).sonl SELECT FROM 
literal => WITH info SELECT FROM 

word *> Iti <- index; 

ENDCASE «> P5ADefs.P5Error[647]; 
ENDCASE => P5ADefs.P5Error[648]; 
WITH ll:(ltb+lti) SELECT FROM 

short »> RETURN [[1 iteral [word[l ti]]]]; 
long ■> 

BEGIN 

SELECT 11. length FROM 

=> P5ADefs.P5Error[649]; 

1 «> 

BEGIN pushlitval[ll .value[0]]; RETURN[topostack] END; 

2 «> 
BEGIN 

pushlitval[ll .value[0]]; 
pushlitval[ll.value[l]]; 
1 <- makeT0Slex[2]; 
RETURN 
END; 
ENDCASE; 
nwords «• 11 .length; 
IF ll.codelndex = THEN 
BEGIN 

ll.codelndex «- movetocodeword[]; 

FOR i IN [0.. nwords) DO wri tecodewordp 1 . value[i]] ; ENDLOOP; 
END; 
cOffset <- ll.codelndex; 
END; 
ENDCASE; 
1 <- SIGNAL MWConstant[cOffset]; 
RequireStack[0]; 
pushlitval[cOffset]; 
pus hi itval [nwords] ; 

destpsize «- loadlexaddress[CopyLex[l ]]; 

CioutO[IF destpsize - wordlength THEN qBLTC ELSE qBLTCL]; 
RETURN 
END; 

Ipushrhs: PUBLIC PROCEDURE [t: TreeLink] RETURNS [Lexeme] - 
BEGIN -- forces a value onto the stack 
size: CARDINAL «- spushrhs[t]; 
RETURN [IF size <« wordlength THEN topostack 

ELSE makeTOSlex[ size/word length]]; 
END; 

pushrhs: PUBLIC PROCEDURE [t: TreeLink] « 
BEGIN -- forces a value onto the stack 
[] <- spushrhs[t]; 
RETURN 
END; 

spushrhs: PROCEDURE [t: TreeLink] RETURNS [size: CARDINAL] - 
BEGIN -- forces a value onto the stack 
size *- wordlength; 
IF t • empty THEN 
BEGIN 
IF CPtr.xtracting THEN RETURN[spushlex[CPtr .xtractlex]]; 
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IF CPtr.f irstcaseselread THEN CPtr .f irstcaseselread «- FALSE 

ELSE C1outO[qPUSH]; 

END 
ELSE RETURN[spushlex[Cexp[t]]]; 
RETURN 
END; 

spushlex: PROCEDURE [1: Lexeme] RETURNS [size: CARDINAL] - 
BEGIN -- forces a lexeme onto the stack 
a: BitAddress; 
bti: CBTIndex; 
r: BDOIndex; 
size «- wordlength; 
IF 1 - topostack THEN RETURN; 
WITH e: 1 SELECT FROM 
literal ■> 

WITH e SELECT FROM 

word ■> pushconst[TreeLink[literal[[word[lexlti]]]]]; 
string ■> pushconst[TreeLink[l iteral [[string[lexsti]]]]]; 
ENDCASE; 
se ■> 
BEGIN 
IF (seb+e. lexsei) . 1 inkSpace THEN 

BEGIN a <- (seb+e. lexsei). idvalue; Cioutl[qLLK, a.wd] END 
ELSE IF (seb+e. lexsei) .constant THEN 

SELECT SymTabDefs.XferMode[(seb+e. lexsei). idtype] FROM 
procedure => 
BEGIN 

bti <- (seb+e. lexsei) . idinfo; 

IF bti = BTNull THEN push! itval [(seb+e. lexsei ). idval ue] 
ELSE pushlprocdesc[bti]; 
END; 
signal, error a > pushlsigdesc[(seb+e. lexsei) . idvalue]; 
ENDCASE => ERROR 
ELSE 
BEGIN 

r <- rmakeBDOItem[e]; 
size «- cb[r]. off set. size; 
Cload[r]; 
END; 
END; 
bdo *> BEGIN size <- cb[e. lexbdoi].of f set .size; Cload[e. lexbdoi] ; END; 
other => WITH e SELECT FROM 
register a > Cregload[lexrn]; 
byte «> 
BEGIN 

Cioutl[(IF long THEN qRSTRL ELSE qRSTR), lexalpha]; 
RETURN 
END; 
ENDCASE; 
ENDCASE; 
RETURN 
END; 

pushlex: PUBLIC PROCEDURE [1: Lexeme] « 
BEGIN 

[] +■ spushlex[l]; 
END; 

Ipushlex: PUBLIC PROCEDURE [1: Lexeme] RETURNS [Lexeme] - 
BEGIN 

size: CARDINAL <- spushlex[l]; 
RETURN [IF size O wordlength THEN topostack 

ELSE makeTOSlex[size/wordlength]]; 
END; 

pushconst: PUBLIC PROCEDURE [t: TreeLink] « 

BEGIN -- forces a 16-bit constant onto the stack 

msti: MSTIndex; 

IF treeliteral[t] THEN 

BEGIN pushlitval[treeliteralvalue[t]]; RETURN END; 
WITH e: t SELECT FROM 
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literal ■> 

WITH e.info SELECT FROM 
string ■> 
BEGIN 

msti ♦■ LitDefs.MasterString[index]; 

IF ~(stb+msti). local THEN Cioutl[qGADRB, (stb+msti ). info] 
ELSE 
BEGIN 

r: BDOIndex «- genBDOItem[]; 
cb[r].tag «- o; 
cb[r]. offset <- [ 

posn: [wd: (stb+msti) . info, bd: 0], 
size: wordlength, 

level: CPtr.curctxlvl - CPtr.catchcount]; 
[] «- loadaddress[r]; 
END; 
END; 
ENDCASE; 
ENDCASE -> P5ADefs.P5Error[650]; 
RETURN 
END; 

pushlitval: PUBLIC PROCEDURE [v: WORD] » 
BEGIN -- forces a constant onto the stack 
Cioutl[qLI, v]; 
RETURN 
END; 

pushlprocdesc: PUBLIC PROCEDURE [bti: CBTIndex] » 

BEGIN -- pushes a descriptor for local procedure on stack 
WITH (bb+bti) SELECT FROM 

Inner «> pushlnestedprocdesc[bti]; 

Outer => pushlnonnestedprocdesc[entryIndex]; 

ENDCASE; 
RETURN 
END; 

pushlnestedprocdesc: PUBLIC PROCEDURE [bti: CBTIndex] ■ 

BEGIN -- pushes a descriptor for nested local procedure on stack 
v: ContextLevel «- (bb+bti) . level - 1; 
r: BDOIndex; 

WITH (bb+bti) SELECT FROM 
Inner ■> 

BEGIN 

r *- genBDOItem[]; 

cb[r].tag <- o; 

cb[r]. offset <- [level: v, posn: [wd: f rameOff set, bd: 0], size: wordlength]; 

[] «- loadaddress[r]; 

RETURN 

END; 
ENDCASE 
END; 

pushlnonnestedprocdesc: PUBLIC PROCEDURE [n: CARDINAL] « 
BEGIN -- pushes a descriptor for local procedure n on stack 
OPEN ControlDefs; 
p: ProcDesc; 

p.gfi «- n/EPRange; 

p.ep <- n MOD EPRange; 

p. tag <- procedure; 

Cioutl[qDESCB, LOOPHOLE[p]] ; 

RETURN 

END; 

pushlsigdesc: PROCEDURE [desc: ControlDefs. SignalDesc] « 
BEGIN 

IF desc.gfi # ControlDefs .GFTNul 1 THEN Cioutl[qDESCB, LOOPHOLE[desc]] 
ELSE pushlitval[LOOPHOLE[desc]]; 
RETURN 
END; 



Csignalinit: PROCEDURE [node: Treelndex] RETURNS [Lexeme] - 
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BEGIN OPEN ControlDefs; 

v: CARDINAL *- ( tb+node) . inf o; 

Cioutl[qDESCB, L00PH0LE[ControTL1nk[procedure[ 

gfi: v/EPRange, 

ep: v MOD EPRange, 

tag: procedure]]]]; 
RETURN [topostack] 
END; 



END... 



